home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Auge 4000 / Auge 4000 #45 (1990-06-20)(Amiga User Gruppe Einzugsgebiet 4000).zip / Auge 4000 #45 (1990-06-20)(Amiga User Gruppe Einzugsgebiet 4000).adf / ANWENDUNGEN / FUNKUHR / FUNKUHR.LST < prev    next >
File List  |  1990-06-20  |  2KB  |  112 lines
  1. ON BREAK GOSUB esc                ! Nehmt die Zeile mal weg - und staund
  2. '
  3. ' Hauptprogramm  Ver 0.02
  4. '
  5. '
  6. ' wdh&
  7. DIM bit&(60)
  8. '
  9. PRINT "Warten..."
  10. WHILE (@tick AND 2)=0             ! Auf Minutenbeginn warten
  11. WEND
  12. CLS
  13. DO
  14.   ~FRE(0)                         ! Garbage-Collection
  15.   CLR fehler&
  16.   FOR wdh&=0 TO 57                ! Bits einlesen - was sonst?
  17.     bit&(wdh&)=@tick
  18.     IF bit&(wdh&)>1               ! Auweia - ein Fehler!
  19.       fehler&=1
  20.       bit&(wdh&)=bit&(wdh&) AND 1
  21.     ENDIF
  22.     EXIT IF fehler&               ! Fehler aufgetreten?
  23.   NEXT wdh&
  24.   '
  25.   ' Dekodierung der Daten und Paritätsprüfung
  26.   '
  27.   CLR pari&
  28.   FOR wdh&=0 TO 27
  29.     ADD pari&,bit&(wdh&)
  30.   NEXT wdh&
  31.   IF EVEN(pari&)
  32.     min&=bit&(20)+bit&(21)*2+bit&(22)*4+bit&(23)*8+bit&(24)*10+bit&(25)*20+bit&(26)*40
  33.   ENDIF
  34.   '
  35.   CLR pari&
  36.   FOR wdh&=28 TO 34
  37.     ADD pari&,bit&(wdh&)
  38.   NEXT wdh&
  39.   IF EVEN(pari&)
  40.     std&=bit&(28)+bit&(29)*2+bit&(30)*4+bit&(31)*8+bit&(32)*10+bit&(33)*20
  41.   ENDIF
  42.   '
  43.   CLR pari&
  44.   FOR wdh&=35 TO 57
  45.     ADD pari&,bit&(wdh&)
  46.   NEXT wdh&
  47.   IF EVEN(pari&)
  48.     tag&=bit&(35)+bit&(36)*2+bit&(37)*4+bit&(38)*8+bit&(39)*10+bit&(40)*20
  49.     wtg&=bit&(41)+bit&(42)*2+bit&(43)*4
  50.     mnt&=bit&(44)+bit&(45)*2+bit&(46)*4+bit&(47)*8+bit&(48)*10
  51.     jhr&=bit&(49)+bit&(50)*2+bit&(51)*4+bit&(52)*8+bit&(53)*10+bit&(54)*20+bit&(55)*40+bit&(56)*80
  52.   ENDIF
  53.   '
  54.   '
  55.   '
  56.   zeit$=STR$(std&)+":"+STR$(min&)
  57.   datum$=STR$(tag&)+"."+STR$(mnt&)+".19"+STR$(jhr&)
  58.   ' LPRINT zeit$;"   ";datum$;"   ";wtg&
  59.   '
  60.   WHILE (@tick AND 2)=0           ! Auf Minutenbeginn warten
  61.   WEND
  62.   SOUND 1500,5
  63.   PRINT AT(27,14);zeit$;"   ";datum$;"   ";wtg&;"       "
  64. LOOP
  65. END
  66. '
  67. ' Daten
  68. '
  69. week:
  70. DATA Montag,Dienstag,Mittwoch,Donnerstag,Freitag,Samstag,Sonntag
  71. '
  72. '
  73. ' Unterprogramme
  74. '
  75. '
  76. > PROCEDURE esc
  77. EDIT
  78. RETURN
  79. > FUNCTION tick
  80. '
  81. ' Variablen
  82. '
  83. ' GLOBAL break%
  84. LOCAL pulse&,ret&
  85. CLR pulse&,ret&                 ! Eigentlich überflüssig...
  86. '
  87. ' Zeiten stoppen
  88. '
  89. WHILE NOT STRIG(1)              ! Ende der Pause abwarten
  90. WEND
  91. break%=TIMER-break%             ! Zeit für Pausenlänge merken
  92. WHILE STRIG(1)                  ! Impuls stoppen
  93. INC pulse&
  94. WEND
  95. '
  96. ' Auswertung
  97. '
  98. IF break%>420 OR break%<140     ! Pause zu lang oder zu kurz?
  99. ret&=4                        ! Fehler - kein Wert zurück, Errorflag setzen
  100. ELSE
  101. ret&=pulse&\700               ! Bit ausrechnen
  102. IF break%>300                 ! Minutenbeginn?
  103.   ret&=BSET(ret&,1)           ! Flag für Minutenbeginn setzen
  104. ENDIF
  105. ENDIF
  106. '
  107. ' noch aufräumen...
  108. '
  109. break%=TIMER
  110. RETURN ret&
  111. ENDFUNC
  112.